home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Art / I / IMAGE 1.45.cpt / Macros / Stacks < prev    next >
Text File  |  1992-07-24  |  13KB  |  639 lines
  1. {This file contains macros that work with stacks.}
  2.  
  3.  
  4. macro 'Add Slice [A]';    begin AddSlice end;
  5. macro 'Delete Slice [D]'; begin DeleteSlice end;
  6.  
  7.  
  8. procedure CheckForStack;
  9. begin
  10.   if nSlices=0 then begin
  11.     PutMessage('This window is not a stack');
  12.     exit;
  13.   end;
  14. end;
  15.  
  16.  
  17. macro 'Run Movie';
  18. var
  19.   i:integer;
  20. begin
  21.   CheckForStack;
  22.   i:=0;
  23.   repeat
  24.     i:=i+1;
  25.     if i>nSlices then i:=1;
  26.     SelectSlice(i);
  27.   until button;
  28. end;
  29.  
  30.  
  31. macro 'Smooth';
  32. var
  33.   i:integer;
  34. begin
  35.   CheckForStack;
  36.   for i:= 1 to nSlices do begin
  37.     SelectSlice(i);
  38.     SetOption; Smooth;
  39.   end;
  40. end;
  41.  
  42.  
  43. macro 'Sharpen';
  44. var
  45.   i:integer;
  46. begin
  47.   CheckForStack;
  48.   for i:= 1 to nSlices do begin
  49.     SelectSlice(i);
  50.     SetOption; Smooth;
  51.     SetOption; Sharpen;
  52.   end;
  53. end;
  54.  
  55.  
  56. macro 'Reduce Noise';
  57. var
  58.   i:integer;
  59. begin
  60.   CheckForStack;
  61.   for i:= 1 to nSlices do begin
  62.     SelectSlice(i);
  63.     ReduceNoise;
  64.   end;
  65. end;
  66.  
  67.  
  68. macro 'Invert';
  69. var
  70.   i:integer;
  71. begin
  72.   CheckForStack;
  73.   for i:= 1 to nSlices do begin
  74.     SelectSlice(i);
  75.     Invert;
  76.   end;
  77. end;
  78.  
  79.  
  80. macro 'Apply LUT';
  81. var
  82.   i,stack,slices:integer;
  83. begin
  84.   CheckForStack;
  85.   stack:=PicNumber;
  86.   slices:=nSlices;
  87.   Duplicate('Temp');
  88.   for i:= 1 to slices do begin
  89.     SelectPic(stack);
  90.     SelectSlice(i);
  91.     ApplyLut;
  92.     SelectPic(nPics);
  93.     if i<>slices then PropagateLut;
  94.   end;
  95.   Dispose(nPics);
  96. end;
  97.  
  98.  
  99. macro 'Remove 0 and 255';
  100. {
  101. Changes 0 to 1 and 255 to 254 in all slices. We want to do this because
  102. pixel values of 0(which always displays as white) and 255(always
  103. displays as black) cause problems when pseudo-coloring images.
  104. }
  105. var
  106.   i:integer;
  107. begin
  108.   CheckForStack;
  109.   for i:= 1 to nSlices do begin
  110.     SelectSlice(i);
  111.     ChangeValues(0,0,1);
  112.     ChangeValues(255,255,254);
  113.   end;
  114. end;
  115.  
  116.  
  117. procedure flip(vertical:boolean);
  118. var
  119.   i:integer;
  120.   SliceSpacing:real;
  121. begin
  122.   CheckForStack;
  123.   for i:= 1 to nSlices do begin
  124.     SelectSlice(i);
  125.     if vertical
  126.       then FlipVertical
  127.       else FlipHorizontal;
  128.   end;
  129. end;
  130.  
  131. macro 'Flip Vertical';   begin flip(true) end;
  132. macro 'Flip Horizontal'; begin flip(false) end;
  133.  
  134.  
  135. procedure CheckForSelection;
  136. var 
  137.   x1,y1,x2,y2,LineWidth:integer;
  138. begin
  139.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  140.   GetLine(x1,y1,x2,y2,LineWidth);
  141.   if (RoiWidth=0) or (x1>=0) then begin
  142.     PutMessage('Please make a rectangular selection.');
  143.     exit;
  144.   end;
  145. end;
  146.  
  147.  
  148. macro 'Clear Outside';
  149. var
  150.   i:integer;
  151.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  152. begin
  153.   CheckForStack;
  154.   CheckForSelection;
  155.   for i:= 1 to nSlices do begin
  156.     SelectSlice(i);
  157.     Copy;
  158.     SelectAll;
  159.     Clear;
  160.     RestoreRoi;
  161.     Paste;
  162.     RestoreRoi;
  163.   end;
  164. end;
  165.  
  166.  
  167. procedure Rotate(left:boolean);
  168. var
  169.   i,OldStack,NewStack:integer;
  170.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  171.   N,NewWidth:integer;
  172.   ScaleFactor,SliceSpacing:real;
  173.   OneToOne:boolean;
  174. begin
  175.   CheckForStack;
  176.   SelectAll;
  177.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  178.   OldStack:=PicNumber;
  179.   SliceSpacing:=GetSliceSpacing;
  180.   N:=nSlices;
  181.   SetNewSize(RoiHeight,RoiWidth);
  182.   MakeNewStack('Stack');
  183.   SetSliceSpacing(SliceSpacing);
  184.   NewStack:=PicNumber;
  185.   SelectPic(OldStack);
  186.   for i:= 1 to N do begin
  187.     SelectSlice(1);
  188.     if left
  189.       then RotateLeft(true)
  190.       else RotateRight(true);
  191.     SelectAll;
  192.     Copy;
  193.     SelectPic(NewStack);
  194.     if i<>1 then AddSlice;
  195.     Paste;
  196.     ChoosePic(nPics);
  197.     Dispose;
  198.     SelectPic(OldStack);
  199.     DeleteSlice;
  200.   end;
  201.   Dispose;
  202. end;
  203.  
  204. macro 'Rotate Left';  begin rotate(true) end;
  205. macro 'Rotate Right'; begin rotate(false) end;
  206.  
  207.  
  208. procedure CropAndScale(fast:boolean);
  209. var
  210.   i,OldStack,NewStack:integer;
  211.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  212.   N,NewWidth:integer;
  213.   ScaleFactor:real;
  214.   OneToOne:boolean;
  215. begin
  216.   CheckForStack;
  217.   CheckForSelection;
  218.   SaveState;
  219.   OldStack:=PicNumber;
  220.   N:=nSlices;
  221.   ScaleFactor:=GetNumber('Scale factor[1.0]:',1.0);
  222.   OneToOne:=ScaleFactor=1.0;
  223.   NewWidth:=round(RoiWidth*ScaleFactor);
  224.   if odd(NewWidth) then begin
  225.     NewWidth:=NewWidth-1;
  226.     ScaleFactor:=NewWidth/RoiWidth;
  227.   end;
  228.   SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  229.   MakeNewStack('Stack');
  230.   NewStack:=PicNumber;
  231.   if not OneToOne then begin
  232.     if fast 
  233.       then SetScaling('Nearest; Create New Window')
  234.       else SetScaling('Bilinear; Create New Window');
  235.   end;
  236.   SelectPic(OldStack);
  237.   for i:= 1 to N do begin
  238.     SelectSlice(1);
  239.     if OneToOne then Duplicate('Temp')
  240.       else ScaleAndRotate(ScaleFactor,ScaleFactor,0);
  241.     SelectAll;
  242.     Copy;
  243.     SelectPic(NewStack);
  244.     if i<>1 then AddSlice;
  245.     Paste;
  246.     ChoosePic(nPics);
  247.     Dispose;
  248.     SelectPic(OldStack);
  249.     DeleteSlice;
  250.   end;
  251.   Dispose;
  252.   RestoreState;
  253. end;
  254.  
  255.  
  256. macro 'Crop and Scale-Fast';   begin CropAndScale(true); end;
  257. macro 'Crop and Scale-Smooth'; begin CropAndScale(false); end;
  258.  
  259.  
  260. macro 'Delete Even Slices';
  261. var
  262.   n:integer;
  263. begin
  264.   CheckForStack;
  265.   SelectSlice(2);
  266.   repeat
  267.     DeleteSlice;
  268.     n:=SliceNumber;
  269.     n:=n+2;
  270.     if n>nSlices then exit;
  271.     SelectSlice(n);
  272.    until false;
  273. end;
  274.  
  275.  
  276. macro 'Replicate Slices';
  277. var
  278.   n,i,RepFactor:integer;
  279. begin
  280.   CheckForStack;
  281.   RepFactor:=GetNumber('Replication factor(2,3,4,5,etc):',2);
  282.   n:=nSlices;
  283.   repeat
  284.     SelectSlice(n);
  285.     SelectAll;
  286.     Copy;
  287.     for i:=2 to RepFactor do begin
  288.       AddSlice;
  289.       Paste;
  290.     end;
  291.     n:=n-1;
  292.    until n=0;
  293.    KillRoi;
  294. end;
  295.  
  296.  
  297. macro 'Merge Two Stacks';
  298. {
  299. Combines two stacks(w1xh1xd1 and w2xh2xd2) to create a new
  300. w1+w2 x max(h1,h2) x max(d1,d2) stack. For example, a 256x256x40
  301. and a 256x256x30 stack would be combined into one 512x256x40 stack.
  302. }
  303. var
  304.   i,w1,w2,w3,h1,h2,h3,d1,d2,d3:integer;
  305. begin
  306.   SaveState;
  307.   if nPics<>2 then begin
  308.     PutMessage('This macro operates on exactly two stacks.');
  309.     exit;
  310.   end;
  311.   SelectPic(1);
  312.   GetPicSize(w1,h1);
  313.   d1:=nSlices;
  314.   SelectPic(2);
  315.   GetPicSize(w2,h2);
  316.   d2:=nSlices;
  317.   if d1>=d2
  318.     then d3:=d1
  319.     else d3:=d2;
  320.   if d3=0 then begin
  321.     PutMessage('Both images must be stacks.');
  322.     exit;
  323.   end;
  324.   w3:=w1+w2;
  325.   if h1>=h2
  326.     then h3:=h1
  327.     else h3:=h2;
  328.   SetNewSize(w3,h3);
  329.   MakeNewStack('Merged');
  330.   for i:=1 to d3 do begin
  331.     SelectPic(1);
  332.     SelectSlice(1);
  333.     SelectAll;
  334.     Copy;
  335.     DeleteSlice;
  336.     SelectPic(3);
  337.     MakeRoi(0,0,w1,h1);
  338.     Paste;
  339.     SelectPic(2);
  340.     SelectSlice(1);
  341.     SelectAll;
  342.     Copy;
  343.     DeleteSlice;
  344.     SelectPic(3);
  345.     MakeRoi(w1,0,w2,h2);
  346.     Paste;
  347.     if i<d3 then AddSlice;
  348.   end;
  349.   SelectPic(1);
  350.   Dispose;
  351.   SelectPic(1);
  352.   Dispose;
  353.   RestoreState;
  354. end;
  355.  
  356.  
  357. macro 'Save Slices as files';
  358. {
  359. This macro saves the slices in a stack as individual TIFF or PICT files using
  360. names of the form needed by Apple's Convert to [QuickTime]Movie utility.
  361. To specify the file type, checked either TIFF or PICT in the SaveAs dialog
  362. box, which should only appear once.
  363. }
  364. var
  365.   i,stack:integer;
  366. begin
  367.   CheckForStack;
  368.   stack:=PicNumber;
  369.   for i:= 1 to nSlices do begin
  370.     SelectPic(stack);
  371.     SelectSlice(i);
  372.     Duplicate('Frame.',i:2);
  373.     SaveAs;
  374.     {Export;}
  375.     Dispose;
  376.   end;
  377. end;
  378.  
  379.  
  380. macro 'Windows to Stack';
  381. {Unlike the menu command of the same name, the windows do not}
  382. {all need to be the same size.}
  383. var
  384.   i,width,height,MinWidth,MinHeight,n,stack:integer;
  385.   isStack:boolean;
  386. begin
  387.   if nPics<=1 then begin
  388.     PutMessage('At least two images must be open.');
  389.     exit;
  390.   end;
  391.   MinWidth:=9999;
  392.   MinHeight:=9999;
  393.   isStack:=false;
  394.   for i:=1 to nPics do begin
  395.     SelectPic(i);
  396.     GetPicSize(width,height);
  397.     if width<MinWidth then MinWidth:=width;
  398.     if height<MinHeight then MinHeight:=height;
  399.     isStack:=isStack or (nSlices>0);
  400.   end;
  401.   if isStack then begin
  402.     PutMessage('This macro does not work with stacks.');
  403.     exit;
  404.   end;
  405.   if odd(MinWidth) then MinWidth:=MinWidth-1;
  406.   n:=nPics;
  407.   SaveState;
  408.   SetNewSize(MinWidth,MinHeight);
  409.   MakeNewStack('Stack');
  410.   stack:=nPics;
  411.   for i:=1 to n do begin
  412.     SelectPic(1);
  413.     MakeRoi(0,0,MinWidth,MinHeight);
  414.     copy;;
  415.     Dispose;
  416.     SelectPic(nPics);
  417.     paste;
  418.     if i<>n then AddSlice;
  419.   end;
  420.   KillRoi;
  421.   RestoreState;
  422. end;
  423.  
  424.  
  425. macro 'Make Cone';
  426. var
  427.   i,size,margin,MaxRadius,r,r2,center,length,color,temp:integer;
  428. begin
  429.   size:=64;
  430.   margin:=5;
  431.   color:=100;
  432.   SaveState;
  433.   SetBackgroundColor(255); {Black}
  434.   SetNewSize(size,size);
  435.   MakeNewWindow('Temp'); {Work-around for bug fixed in V1.42}
  436.   temp:=nPics;
  437.   MakeNewStack('Cone');
  438.   for i:=1 to margin do AddSlice;
  439.   MaxRadius:=(size-2*margin)/2;
  440.   center:=size div 2;
  441.   length:=size-2*margin-1;
  442.   for i:=1 to length do begin
  443.     AddSlice;
  444.     r:=MaxRadius*(i/length);
  445.     MakeOvalRoi(center-r,center-r,r*2,r*2);
  446.     SetForegroundColor(color);
  447.     Fill;
  448.     if (i>length/2) and (i<(length-margin)) then begin
  449.       r2:=MaxRadius/6;
  450.       MakeOvalRoi(center-2.125*r2,center-1.3*r2,r2*2,r2*2);
  451.       SetForegroundColor(color-25);
  452.       Fill;
  453.       MakeOvalRoi(center+0.625*r2,center-0.7*r2,r2*2,r2*2);
  454.       SetForegroundColor(color+25);
  455.       Fill;
  456.     end;
  457.   end;
  458.   KillRoi;
  459.   for i:=1 to margin do AddSlice;
  460.   SelectPic(temp);
  461.   Dispose;
  462.   RestoreState;
  463. end;
  464.  
  465.  
  466. procedure DoReslicing(horizontal:boolean);
  467. var
  468.   stack1,stack2,width,height:integer;
  469.   RoiLeft,RoiTop,RoiWidth,RoiHeight,max:integer;
  470.   InputSpacing,OutputSpacing,loc:real;
  471.   FirstTime:boolean;
  472. begin
  473.   RequiresVersion(1.45);
  474.   CheckForStack;
  475.   CheckForSelection;
  476.   SaveState;
  477.   SetBackground(0);
  478.   SetBackground(255);
  479.   stack1:=PicNumber;
  480.   InputSpacing:=GetSliceSpacing;
  481.   if InputSpacing<=0 then InputSpacing:=1;
  482.   InputSpacing:=GetNumber('Input Slice Spacing(Pixels):',InputSpacing);
  483.   SetSliceSpacing(InputSpacing);
  484.   OutputSpacing:=InputSpacing);
  485.   OutputSpacing:=GetNumber('Output Slice Spacing(Pixels):',OutputSpacing));
  486.   FirstTime:=true;
  487.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  488.   if horizontal then begin
  489.     loc:=RoiTop+OutputSpacing;
  490.     max:=RoiTop+RoiHeight;
  491.   end else begin
  492.     loc:=RoiLeft+OutputSpacing;
  493.     max:=RoiLeft+RoiWidth;
  494.   end;
  495.   while loc<max do begin
  496.     ChoosePic(stack1);
  497.     if horizontal
  498.       then MakeLineRoi(RoiLeft,loc,RoiLeft+RoiWidth,loc)
  499.       else MakeLineRoi(loc,RoiTop,loc,RoiTop+RoiTop+RoiHeight);
  500.     Reslice;
  501.     SelectAll;
  502.     Copy;
  503.     GetPicSize(width,height);
  504.     Dispose;
  505.     if FirstTime then begin
  506.       SetNewSize(width,height);
  507.       MakeNewStack(OutputSpacing:1:2);
  508.       SetSliceSpacing(OutputSpacing);
  509.       stack2:=PicNumber;
  510.     end;
  511.     ChoosePic(stack2);
  512.     if not FirstTime then AddSlice;
  513.     Paste;
  514.     loc:=loc+OutputSpacing;
  515.     FirstTime:=false;
  516.   end;
  517.   SelectPic(stack1);
  518.   KillRoi;
  519.   SelectPic(stack2);
  520.   KillRoi;
  521.   RestoreState;
  522. end;
  523.  
  524.  
  525. macro 'Reslice Horizontally'; begin DoReslicing(true) end;
  526. macro 'Reslice Vertically';   begin DoReslicing(false) end;
  527.  
  528.  
  529. macro '(-' begin end;
  530.  
  531.  
  532. procedure ResliceSignaMRI(horizontal,OptionKey:boolean);
  533. var
  534.   stack1,stack2,width,height:integer;
  535.   RoiLeft,RoiTop,RoiWidth,RoiHeight,max:integer;
  536.   loc,PixelSpacing:real;
  537.   InputSpacing,OutputSpacing:real; {mm}
  538.   scale:real; {pixels/mm}  
  539.   FirstTime:boolean;
  540. begin
  541.   scale:=1.0666; {Assumes 256x256 slices and 240mm field of view}
  542.   RequiresVersion(1.45);
  543.   CheckForStack;
  544.   CheckForSelection;
  545.   SaveState;
  546.   SetScale(scale,'mm');
  547.   SetBackground(0);
  548.   SetBackground(255);
  549.   stack1:=PicNumber;
  550.   InputSpacing:=GetSliceSpacing/scale;
  551.   if InputSpacing<=0 then InputSpacing:=1.5;
  552.   InputSpacing:=GetNumber('Input Slice Spacing(mm):',InputSpacing);
  553.   SetSliceSpacing(InputSpacing*scale);
  554.   OutputSpacing:=InputSpacing);
  555.   OutputSpacing:=GetNumber('Output Slice Spacing(mm):',OutputSpacing));
  556.   PixelSpacing:=OutputSpacing*scale;
  557.   FirstTime:=true;
  558.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  559.   if horizontal then begin
  560.     loc:=RoiTop+PixelSpacing;
  561.     max:=RoiTop+RoiHeight;
  562.   end else begin
  563.     loc:=RoiLeft+PixelSpacing;
  564.     max:=RoiLeft+RoiWidth;
  565.   end;
  566.   while loc<max do begin
  567.     ChoosePic(stack1);
  568.     if horizontal
  569.       then MakeLineRoi(RoiLeft,loc,RoiLeft+RoiWidth,loc)
  570.       else MakeLineRoi(loc,RoiTop,loc,RoiTop+RoiTop+RoiHeight);
  571.     if OptionKey then SetOption;
  572.     Reslice;
  573.     SelectAll;
  574.     Copy;
  575.     GetPicSize(width,height);
  576.     Dispose;
  577.     if FirstTime then begin
  578.       SetNewSize(width,height);
  579.       MakeNewStack(OutputSpacing:1:2);
  580.       SetSliceSpacing(PixelSpacing);
  581.       stack2:=PicNumber;
  582.     end;
  583.     ChoosePic(stack2);
  584.     if not FirstTime then AddSlice;
  585.     Paste;
  586.     loc:=loc+PixelSpacing;
  587.     FirstTime:=false;
  588.   end;
  589.   SelectPic(stack1);
  590.   KillRoi;
  591.   SelectPic(stack2);
  592.   KillRoi;
  593.   RestoreState;
  594. end;
  595.  
  596.  
  597. macro 'Import GE Signa Files';
  598. Var
  599.   i,n,max,stack,first:integer;
  600.   scale:real; {pixels/mm}
  601. begin
  602.   scale:=1.066666; {assumes 256x256 slices with 240mm field of view}
  603.   first:=round(GetNumber('Number of first slice:',1));
  604.   max:=round(GetNumber('Maximum pixel value:',255));
  605.   SetNewSize(256,256);
  606.   MakeNewStack('Stack');
  607.   stack:=nPics;
  608.   MoveWindow(340,40);
  609.   SetScale(scale,'mm');
  610.   SetCustom(256,256,14336);
  611.   SetImport('Custom; 16-bits Signed; Fixed Scale');
  612.   SetImportMinMax(0,max);
  613.   n:=first;
  614.   for i:=1 to 256 do begin
  615.     Import('i.',n:3);
  616.     SetPicName('i.',n:3);
  617.     SelectAll;
  618.     Copy;
  619.     Dispose;
  620.     SelectPic(stack);
  621.     if n<>first then AddSlice;
  622.     n:=n+1;
  623.     Paste;
  624.    end;
  625. end;
  626.  
  627.  
  628. macro 'Sagitals to Coronals'; begin ResliceSignaMRI(false,true) end;
  629.  
  630. macro 'Sagitals to Axials'; begin ResliceSignaMRI(true,true) end;
  631.  
  632. macro 'Coronals to Sagitals'; begin ResliceSignaMRI(false,true) end;
  633.  
  634.  
  635.  
  636.  
  637.  
  638.  
  639.